home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 June / CHIP 2005-06.iso / program / yazilim / myscreencapture.exe / {app} / Demo VB6 / ToSaveInJPEG.bas < prev   
Encoding:
BASIC Source File  |  2004-10-13  |  4.7 KB  |  120 lines
  1. Attribute VB_Name = "ToSaveInJPEG"
  2. Option Explicit
  3. '
  4. 'This is an example showing how to save a picture into JPEG format
  5. 'using the INTEL FREE Library.
  6. 'There is NO SUPPORT on this part of code.
  7. '
  8. 'If you don't need to save in JPEG format the capture, you don't need to
  9. 'include this part of code in your application.
  10. '
  11. '
  12. '
  13. ' ==================================================================================
  14. ' Requires:    cDIBSectionmod.cls
  15. '              ijl15.dll (Intel)
  16. ' An interface to Intel's IJL (Intel JPG Library) for use in VB.
  17. ' ==================================================================================
  18.  
  19. Private Enum IJLERR
  20.     IJL_OK = 0
  21. End Enum
  22.  
  23. Private Enum IJLIOTYPE
  24.     ''// Write an entire JFIF bit stream.
  25.     IJL_JFILE_WRITEWHOLEIMAGE = 8&
  26. End Enum
  27.  
  28. Type JPEG_CORE_PROPERTIES_VB
  29.     UseJPEGPROPERTIES As Long                      '// default = 0
  30.     '// DIB specific I/O data specifiers.
  31.     DIBBytes As Long ';                  '// default = NULL 4
  32.     DIBWidth As Long ';                  '// default = 0 8
  33.     DIBHeight As Long ';                 '// default = 0 12
  34.     DIBPadBytes As Long ';               '// default = 0 16
  35.     DIBChannels As Long ';               '// default = 3 20
  36.     DIBColor As Long ';                  '// default = IJL_BGR 24
  37.     DIBSubsampling As Long  ';            '// default = IJL_NONE 28
  38.     '// JPEG specific I/O data specifiers.
  39.     JPGFile As Long 'LPTSTR              JPGFile;                32   '// default = NULL
  40.     JPGBytes As Long ';                  '// default = NULL 36
  41.     JPGSizeBytes As Long ';              '// default = 0 40
  42.     JPGWidth As Long ';                  '// default = 0 44
  43.     JPGHeight As Long ';                 '// default = 0 48
  44.     JPGChannels As Long ';               '// default = 3
  45.     JPGColor As Long           ';                  '// default = IJL_YCBCR
  46.     JPGSubsampling As Long  ';            '// default = IJL_411
  47.     JPGThumbWidth As Long ' ;             '// default = 0
  48.     JPGThumbHeight As Long ';            '// default = 0
  49.     '// JPEG conversion properties.
  50.     cconversion_reqd As Long ';          '// default = TRUE
  51.     upsampling_reqd As Long ';           '// default = TRUE
  52.     jquality As Long ';                  '// default = 75.  90 is my preferred quality setting.
  53.     '// Low-level properties - 20,000 bytes.  If the whole structure
  54.     ' is written out then VB fails with an obscure error message
  55.     ' "Too Many Local Variables" !
  56.     ' These all default if they are not otherwise specified so there
  57.     ' is no trouble.
  58.     jprops(0 To 19999) As Byte
  59. End Type
  60.  
  61. Private Declare Function ijlInit Lib "ijl15.dll" (jcprops As Any) As Long
  62. Private Declare Function ijlFree Lib "ijl15.dll" (jcprops As Any) As Long
  63. Private Declare Function ijlWrite Lib "ijl15.dll" (jcprops As Any, ByVal ioType As Long) As Long
  64. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy _
  65.     As Long)
  66.  
  67.  
  68. Public Function SaveJPG(ByRef cDib As cDIBSection, ByVal sFile As String, Optional ByVal lQuality As Long _
  69.         = 90) As Boolean
  70.     
  71.   Dim tJ As JPEG_CORE_PROPERTIES_VB
  72.   Dim bFile() As Byte
  73.   Dim lptr As Long
  74.   Dim lR As Long
  75.     
  76.     lR = ijlInit(tJ)
  77.     If lR = IJL_OK Then
  78.         ' Set up the DIB information:
  79.         ' Store DIBWidth:
  80.         tJ.DIBWidth = cDib.Width
  81.         ' Store DIBHeight:
  82.         tJ.DIBHeight = -cDib.Height
  83.         ' Store DIBBytes (pointer to uncompressed JPG data):
  84.         tJ.DIBBytes = cDib.DIBSectionBitsPtr
  85.         ' Very important: tell IJL how many bytes extra there
  86.         ' are on each DIB scan line to pad to 32 bit boundaries:
  87.         tJ.DIBPadBytes = cDib.BytesPerScanLine - cDib.Width * 3
  88.         
  89.         ' Set up the JPEG information:
  90.         
  91.         ' Store JPGFile:
  92.         bFile = StrConv(sFile, vbFromUnicode)
  93.         ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte
  94.         bFile(UBound(bFile)) = 0
  95.         lptr = VarPtr(bFile(0))
  96.         CopyMemory tJ.JPGFile, lptr, 4
  97.         ' Store JPGWidth:
  98.         tJ.JPGWidth = cDib.Width
  99.         ' .. & JPGHeight member values:
  100.         tJ.JPGHeight = cDib.Height
  101.         ' Set the quality/compression to save:
  102.         tJ.jquality = lQuality
  103.         ' Write the image:
  104.         lR = ijlWrite(tJ, IJL_JFILE_WRITEWHOLEIMAGE)
  105.         If lR = IJL_OK Then
  106.             SaveJPG = True
  107.         Else
  108.             ' Throw error
  109.             MsgBox "Failed to save to JPG", vbExclamation
  110.         End If
  111.         ' Ensure we have freed memory:
  112.         ijlFree tJ
  113.     Else
  114.         ' Throw error:
  115.         MsgBox "Failed to initialise the IJL library: " & lR, vbExclamation
  116.     End If
  117. End Function
  118.  
  119.  
  120.